perm filename RESPC.F4[MSS,LCS]4 blob sn#260750 filedate 1977-01-28 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		SUBROUTINE RESPC
C00021 ENDMK
CāŠ—;
	SUBROUTINE RESPC
	COMMON/STF/RSTFAC(8),RSTJ2 /POSI/STFF(8),JJ2,JPQ
	1 /IPG/IPG,JPG,BRACK(-3/4),RSTNUM(8),RPSZ(8),RHGT(8),
	1 RCLEF(-3/4) /IVV/IV(1)
	COMMON RS,JA,REST,J2,RQ(18),JX,PR,LX,RDIS
C  ORDER OF COMMON BLOCKS **MUST** STAY AS IS!
	COMMON/XRN/RN(1) /SF/KL,RT,KP,STFSZ,NAMX
	1 /PTR/KWDS(1)/LLL/L,LL,I,IX/XXX/LK,LP,JY /JN/J,N
C  INCREASE DIMENSION OF KWDS FOR VERY FULL PAGES.
      DIMENSION NRD(100),MM(1500),NN(1500),BARS(509),E(100),F(100),
	1 G(100),H(100),KPN(1),HH(100),HHH(100),DUMMY(100)
	INTEGER DUMMY
	COMMON /PX/PN(1) /Q/Q(1)
	1 /RCLF/KK,CLEF,KW,ITEM,RSTAFF,SN,YN,RNAM,RNAM2,RNAM3
	1 /KBAR/KBAR(512) /RSP/KNM(10),ENDLN,KQ,NAME,NMPG,SPCNT
	DATA FIB/.8/  ,RSPC/28./,PGNUM/1.6/,RNMHT/16.0/,RNMSZ/1.2/
	1 ,RLTRSZ/1.0/,SPCPG/2.7/,SPCRX/1.5/
C  RSPC=28 SEEMS TO BE ARBITRARY. SPCRX USED IN RHYTH RESPACE.
	EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5)),(MM,RN)
	1,(NN,RN(501)),(KPN,PN),(KS,RS),(BARS,KBAR(4)),(HHH,RN(2250))
	1,(R8,RQ(6)),(R9,RQ(7)),(RQ(10),XLFT),(KBR,KBAR),(T,KBAR(2))
	1,(LASTNM,KBAR(3)),(LCNT,IV(45)),(NDPY,IV(46)),(HH,RN(1250))
	1,(E,RN(1000)),(F,RN(2500)),(G,RN(2700)),(H,RN(2850))
	1,(DUMMY,RN(1400))
C  RQ(2) IS R4, RQ(3) IS R5 ETC.

	IF(NMPG.EQ.'PAGEA')RNEXT=0
	SPCNT=1.0
	JX=0
	JCEN=0
C  FLAG FOR CENTERED RESTS.
	XT=0
	PX=0
	CALL SHFT1(KQ)
	KK=L
CC	TYPE 3001,L
C  DELETES EXTRA BAR LINES, ETC.
	IF(IPG)CALL RESTS
C???	IF(N)RETURN
C N IS NEG., ONLY RESTS WERE ON THIS LINE. (WHAT ABOUT LAST LINE???)
C  FROM NOW ON ALL CODES #-1 ARE IGNORED, RESTS HAVE BEEN COMBINED.
	CALL SHIFT
C  L=NUMBER OF ITEMS FOR RHY RECONS.
	JJ2=L+2
C FOR WDCNT IN .PAG FILE
	N=0
	S=-100
	R=0
	KCLEF=0

	DO 601 K=1,L
	R=CODEN(KPN,K,Q,J)
	RZ=Q(J)
CX	J=KPN(K)
CC	N=N+1
CC	NN(N)=0
CC	MM(N)=J+3
	CALL MMNN(3)
CX	R=Q(J+1)
801	IF(R.NE.1)GO TO 2801
	IF(RZ.LT.7)GO TO 601
	IF(Q(J+9).LT..05)GO TO 601
CC	IF(Q(J+8).EQ.1000)GO TO 601
C  SKIP GRACE NOTE, OR NOTES WITHOUT RHY., OR .LT.1/88 NOTES.
	GO TO 702
2801	IF(R.NE.2)GO TO 1801
	IF(RZ.LT.5)GO TO 601
	IF(IPG)GO TO 1801
	IF(RZ.GE.6)JCEN=-1 
CC	IF(RZ.GE.6)GO TO 601
C  MUST ALIGN REST WITH FIRST RHYTH ON OTHER STAFF.
C  THIS WILL IGNORE WHOLE RESTS IN CENTER OF MEASURE.
1801	IF(R.LT.4)GO TO 702
	IF(R.EQ.17)GO TO 1702
	IF(R.EQ.18)GO TO 1702
	IF(R.LE.7)GO TO 30
	IF(R.NE.44)GO TO 601
	IF(RZ.EQ.2)GO TO 601
C RZ=2= BAR LINE ON UPPER STAFF
	IF(Q(J+6).EQ.0)GO TO 601
	IF(Q(J+5).EQ.0)GO TO 601
C  GETS LEFT END OF LINES, CRESC., DASHES.
	GO TO 604
30	IF(R.NE.7)GO TO 605
	IF(RZ.LT.5)GO TO 604
C JUMP FOR STANDARD TRILL
	RS=Q(J+7)
	IF(RS.EQ.1)GO TO 604
	IF(ABS(RS).GE.3)GO TO 604
C JUMP FOR 8VA, 15MA, ELSE THIS IS A PEDAL MARK WITHOUT LINE.
	GO TO 601
605	IF(R.NE.4)GO TO 604
	IF(RZ.LE.3)GO TO 702
C JUMP IF IT IS A BAR LINE
CC	IF(RZ.LT.4)GO TO 601
	IF(Q(J+6).NE.0)GO TO 604
C GO GET OTHER POS OF LINE
	GO TO 601
1702	IF(Q(J+4).NE.0)GO TO 601
	IF(Q(J+2).NE.0)GO TO 601
C IGNORE METER NOT IN VERT. POS. 0. (PUT IN OTHER PROGS!)
702	NN(N)=R 
	GO TO 601
C NEXT FOR MULTIPOSITION ITEMS: LINES, SLURS, BEAMS, TRILL, 8VA
604	CALL MMNN(6)
C NEXT POS2, 3 AND 4 OF CERTAIN ITEMS
	IF(R.NE.6)GO TO 601
C NEXT FOR BEAMS
	IF(RZ.LT.8)GO TO 608
	IF(Q(J+10).EQ.0)GO TO 608
	IF(Q(J+7).GT.0)CALL MMNN(8)
C NEXT SHIFTS P8 OF COMPOSITE BEAMS
608	IF(RZ.LT.7)GO TO 601
	IF(Q(J+7))GO TO 688
C  P7 IS NEG FOR TREMOLO
	IF(Q(J+8).EQ.0)GO TO 601
C P8 NEG OR POS = POS3 IN P9; P8=0= P9 IS NUM.
688	IF(Q(J+9).GT.0)CALL MMNN(9)
C FOUND A POS. IN P9
601	CONTINUE

C NEXT SORTS THE POINTS
6000	J=1
610	IF(Q(MM(J)).LE.Q(MM(J+1)))GO TO 710
	CALL EXCHG(MM(J),NN(J))
C  ABOVE EXCHGS --(J) AND --(J+1)
	IF(J.EQ.1)GO TO 710
	J=J-1
	GO TO 610
710	J=J+1
	IF(J.LT.N)GO TO 610
C NOW ALL SORTED
	CALL FNDEND(R)
	CALL SHFTQ(R)
C  SHIFTS TO PROPER HORIZ. POS.
	IF(IPG)CALL RESTP
C  RESTP COMBINES LEFTOVER NUMBERED BARS OF RESTS.
	IF(N.LE.0)GO TO 122
C N IS NEG IF ONLY RESTS ON THIS LINE.  GO BACK.

	DO 119 K=1,150
119	HH(K)=0
C  HH ARRAY WILL HOLD FINAL COMPOSITE.
	G(1)=0
	E(1)=0
	F(1)=0
	RN(1500)=0
	RN(2500)=0
	ST=0
C ST=STAFF NUM, T=TOTAL RHYTHMS, J=CNTR OF MAIN POS. ARRAY
C JJ=CNTR FOR 2ND POS. ARRAY, JJJ=CNTR FOR 3RD.
	KE=0
	J=1000
933	JJ=1500
	JJJ=2000
	T=0
	M=0
	A=0
	B=0

	DO 33 K=1,N
	IF(NORH(KK))GO TO 33
CC	KK=NN(K)
CC	IF(KK.EQ.0)GO TO 33
CC	IF(KK.EQ.4)GO TO 2133
CC	IF(KK.EQ.17)GO TO 2133
C SKIP OVER STAFF # TRAP WITH BARS, METER, KSIG.
CC	IF(KK.EQ.18)GO TO 2133
CC	IF(KK.GT.2)GO TO 33
2133	LL=MM(K)-3
	IF(KK.LE.2)GO TO 1133
	RH=.01
C RHYTHMIC VALUE OF BARLINE, METER, KSIG
CCC	IF(KK.NE.4)RH=.6
	GO TO 3133
1133	IF(Q(LL+2).NE.ST)GO TO 33
C JUMP IF NOT ON RIGHT STAFF
	RA=9
	IF(KK.EQ.2)RA=7
	IF(Q(LL).LT.RA-2)GO TO 33
C JUMP IF WDCNT IS TOO SHORT
	RH=Q(LL+IFIX(RA))
	IF(RH.EQ.0)GO TO 33
3133	RZ=Q(LL+3)
	IF(ZERO(RZ,A).EQ.0)GO TO 133
C  JUMP IF THIS NOTE IN SAME POS. AS LAST ONE.
	RRH=RH
C SAVE RHYTH TO CHECK WITH OTHER IN SAME POS.
	TT=T
C SAVE TOTAL RHYTHM BEFORE THIS NOTE.
	J=J+1
C UPDATE COUNTER IN POSITION ARRAY
	T=T+RH
C ADD TO TOTAL RHYTHM
	RN(J)=T
	A=Q(LL+3)
C SAVE POS. OF THIS NOTE.
	GO TO 33
133	IF(RH.EQ.RHH)GO TO 33
C  IGNORE 2ND RHYTH IF SAME AS FIRST
	IF(ZERO(RZ,B).EQ.0)GO TO 333
C JUMP IF A THIRD DIFFERENT  RHYTHM IN SAME POS. (THIS IS THE LIMIT!)
	TTT=TT
C SAVE TOTAL RHYTHM TO THIS POINT.
	TT=TT+RH
	JJ=JJ+1
C UPDATE COUNTER FOR 2ND ARRAY
	RN(JJ)=TT
	RRRH=RH
	B=A
	GO TO 33
333	IF(RH.EQ.RRRH)GO TO 33
	TTT=TTT+RH
	JJJ=JJJ+1
	RN(JJJ)=TTT
33	CONTINUE
C NOW COMPARE THIS WITH BASIC RHYTHM ARRAY (STARTS AT RN(1001)
	IF(ST.NE.0)GO TO 733
	KE=J-999
C TOTAL NUM OF RHYTHMS ON STAFF1.
	IF(JPG.EQ.0)GO TO 2233
C  JUMP IF ONLY ONE STAFF
733	KF=J-2499
C KF=NUM OF RHYTHMS ON NEXT STAFF.
	ST=ST+1
	IF(ST.GT.1)GO TO 833
C JUMP IF ALL STAVES HAVE BEEN READ.
1233	J=2500
	GO TO 933
833	IF(J.NE.2500)GO TO 1533
C  JUMP IF THERE IS ONLY ONE LINE OF RHYTHM
C NOW LINE ONE STARTS AT RN(1001), LINE 2 AT RN(2501)

2233	CALL RLOOP(HH,E,KE)
C FOR SINGLE STAFF OF RHYTHM
	KL=KE
	GO TO 1333
1533	K=1
	L=1
	M=0
19	KK=K
	LL=L
1	SM=10000
	K=K+1
	IF(K.GT.KE)GO TO 10
4	L=L+1
	Y=F(L)
	B=Y-F(L-1)
	IF(B.LT.SM)SM=B
2	X=E(K)
	A=X-E(K-1)
C  A AND B HAVE TRUE DURATIONS NOW
	IF(A.LT.SM)SM=A
C SM = SMALLEST RHYTH VALUE BEFORE NEXT CONTACT
	IF(ZERO(X,Y).EQ.0)GO TO 3
C JUMP IF EQUAL RHYTHS
	IF(X.GT.Y)GO TO 4
	K=K+1
C STEP FORWARD UNTIL X IS .GT. Y
	GO TO 2
3	IF(K.NE.KK+1)GO TO 13
	IF(L.NE.LL+1)GO TO 14
	M=M+1
	G(M)=E(KK)
	GO TO 19
13	IF(L.NE.LL+1)GO TO 15
	DO 16 J=KK,K-1
	M=M+1
16	G(M)=E(J)
	GO TO 19
14	DO 17 J=LL,L-1
	M=M+1
17	G(M)=F(J)
	GO TO 19
15	XM=SM-.001
	M=M+1
	P=E(KK)
	G(M)=P
7	KK=KK+1
	LL=LL+1
	YM=SM*1.5
C THIS COULD BE *2 (NOTE /16/8./ VS. /6/12/ )
	S=P
	T=P
27	A=E(KK)
	B=F(LL)
	IF(ZERO(A,B).EQ.0)GO TO 19
	X=ZERO(A,P)
	Y=ZERO(B,P)
C  FUNCT. ZERO:  ZERO=B-P, IF(ABS(ZERO).LT..01)ZERO=0
	S=E(KK-1)
	T=F(LL-1)
9	IF(A-S.LT.X-.01)X=ZERO(A,S)
	IF(B-T.LT.Y-.01)Y=ZERO(B,T)
	IF(A.GT.B+.01)GO TO 8
	B=A
	KK=KK+1
62	IF(X.GT.YM)GO TO 5
	IF(X.EQ.0)GO TO 27
	P=P+SM
25	M=M+1
	G(M)=P
	GO TO 27
5	P=P+SM
	IF(P)GO TO 203
C IF(P)ERROR
	IF(P.LT.B-.01)GO TO 5
	GO TO 25
8	X=Y
	LL=LL+1
	GO TO 62
10	M=M+1
	G(M)=E(KE)
CC	TYPE 410,(E(K),K=1,KE)
CC	TYPE 410,(F(K),K=1,KF)
CC	TYPE 410,(G(K),K=1,M)
CBCB	WRITE(21,410)(E(K),K=1,KE)
CB	WRITE(21,410)(F(K),K=1,KF)
CB	WRITE(21,410)(G(K),K=1,M)
410	FORMAT(10F7.2)
C NEXT SECTION SETS UP COMPLETE RHYTH COMPOSITE(NEGS. OR NON-SPC VALS.)
1033	JJ=1
	H(1)=0
	J=1
	K=2
	L=2
511	IF(J.EQ.M)GO TO 911
	J=J+1
	X=G(J)
1211	A=E(K)
	B=F(L)
	Y=ZERO(X,A)
	Z=ZERO(X,B)
	IF(A-B.GT..01)GO TO 1111
	IF(Y.EQ.0)GO TO 1311
	IF(X.LT.A-.01)GO TO 1111
	K=K+1
1411	JJ=JJ+1
	H(JJ)=-A
	GO TO 1211
1111	IF(Z.EQ.0)GO TO 1311
	IF(X.LT.B-.01)GO TO 1311
	L=L+1
	A=B
	GO TO 1411

1311	JJ=JJ+1
	H(JJ)=X
	IF(Y.EQ.0)GO TO 611
	IF(Z.EQ.0)GO TO 711
	IF(ZERO(A,B).EQ.0)GO TO 511
	P=A
	IF(P.GT.B+.01)GO TO 811
	IF(P.GT.X+.01)GO TO 511
	K=K+1
	GO TO 1011
811	P=B
	IF(P.GT.X+.01)GO TO 511
	L=L+1
1011	JJ=JJ+1
	H(JJ)=-P
C NON-SPACED RHYTHS ARE NEG.
	GO TO 511
611	K=K+1
	IF(Z.GT.0)GO TO 511
711	L=L+1
	GO TO 511
911	IF(HH(2).EQ.0)GO TO 2011
	K=2
	J=2
	L=1
	HHH(1)=0
1511	IF(J.GT.JJ)GO TO 1811
	P=H(J)
	A=ABS(P)
	B=ABS(HH(K))
	IF(ZERO(B,A).EQ.0)GO TO 1611
	IF(A.GT.B)GO TO 1711
	J=J+1
	GO TO 1911
1711	P=HH(K)
	GO TO 2211
1611	J=J+1
2211	K=K+1
1911	L=L+1
	HHH(L)=P
	GO TO 1511
2011	CALL RLOOP(HH,H,JJ)
	KL=JJ
	GO TO 2111
1811	CALL RLOOP(HH,HHH,L)
	KL=L
2111	IF(ST.GE.JPG)GO TO 1333
	CALL RLOOP(E,G,M)
	KE=M
C GO WAY BACK AND READ ANOTHER LINE.
	GO TO 1233
1333	E(1)=0
	GO TO 2333
	TYPE 410,(HH(K),K=1,KL)
	WRITE(21,410)(HH(K),K=1,KL)
2333	JD=1
C JD IS COUNTER FOR DUMMY POSITIONS.
	DUMMY(1)=1
	ST=0
183	B=0
	LL=2

	DO 181 K=1,N
	IF(NORH(L))GO TO 181
C LOOK FOR DUMMY RHYTHMS.
	IF(L.LE.2)GO TO 2184
	RZ=.01
C  RHYTHMIC VALUE OF BAR, METER, KSIG.  CHANGED TO ABS. SIZE LATER.
	GO TO 1184
2184	LF=MM(K)
	IF(Q(LF-1).NE.ST)GO TO 181
C FOUND RHYTH ON RIGHT STAFF (LF PNTS TO PARAM 3)
	J=6
	IF(L.EQ.2)J=4
	RZ=Q(LF+J)
1184	B=B+RZ
184	V=ABS(HH(LL))
	IF(ZERO(B,V).GT.0)GO TO 182
C FOUND RHYTH MATCH
	JD=JD+1
	DUMMY(JD)=LL
	LL=LL+1
	GO TO 181
182	IF(B.LT.V-.01)GO TO 181
	LL=LL+1
	GO TO 184
181	CONTINUE
	ST=ST+1
	IF(ST.LT.JPG)GO TO 183

C NEXT SORT DUMMY ARRAY
	J=0
185	DO 186 K=2,JD
	IF(DUMMY(K).NE.DUMMY(K-1))GO TO 187
	DO 188 LL=K,JD
188	DUMMY(LL-1)=DUMMY(LL)
	JD=JD-1
	GO TO 185
187	IF(DUMMY(K).GT.DUMMY(K-1))GO TO 186
	CALL EXCH(DUMMY(K),DUMMY(K-1))
	GO TO 185
186	CONTINUE
C NOW DUMMY CONTAINS ALL NON-DUMMY RHYTHS!!!
	PX=0
	LF=0
	K=1
	V=0

81	K=K+1
	IF(K.GT.KL)GO TO 1433
	B=HH(K)
	A=B-V
	V=B
	IF(V)GO TO 82
85	W=V
	IF(A.GT.0.01)GO TO 89
C  .GT. BECAUSE OF ROUND-OFF ERROR
	T=5
	IF(HH(K+1)-V.LE..01)T=2
	PX=PX+T
C THIS FOR BARS, KSIG, METER
	GO TO 189
89	PX=PX+PFIB(A)
189	E(K)=PX
	IF(LF.NE.0)GO TO 86
	GO TO 81
82	LF=K
83	K=K+1
	V=HH(K)
	IF(V)GO TO 83
	A=V-W
	GO TO 85
86	LL=LF-1
	D=E(K)-E(LL)
87	S=-HH(LF)-HH(LL)
	T=HH(K)-HH(LL)
	T=S/T
C  THIS FINDS POS OF NON-IMPORTANT RHY BETWEEN IMPORTANT ONES.
	E(LF)=E(LL)+D*T
	LF=LF+1
	IF(LF.NE.K)GO TO 87
	LF=0
	GO TO 81

1433	GO TO 2433
	TYPE 410,(E(K),K=1,KL)
	WRITE(21,410)(E(K),K=1,KL)
C  5 IS SPACE AFTER 1ST BARLINE
2433	R8=RNEXT
C POS OF 1ST BAR = END OF PREV. LINE
	IF(ENDLN.EQ.0)RNEXT=9
C  MAKES ROOM FOR 1ST CLEF.
	KL=KL-1
	J=0
	R5=0
	KK=1
	JD=1
	W=0
	LF=0

	DO 80 K=1,N
	IF(NORH(L))GO TO 80
	A=Q(MM(K))
	IF(ZERO(A,W).EQ.0)GO TO 80
C  SKIP IF SAME POS OF NOTE OR REST.
	W=A
	R7=R8
190	J=J+1
	IF(J.LE.KL)GO TO 290
	IF(JCEN)TYPE 203
203	FORMAT(' FOUND CENTERED WHOLE REST!')
	PAUSE' RHYTHM MISMATCH'
	GO TO 90
290	IF(DUMMY(JD).NE.J)GO TO 190
	JD=JD+1
90 	R8=RNEXT+E(J)
	R4=R5
	R5=A
	X=(R8-R7)/(R5-R4)
	S=R7-R4*X
	DO 91 L=KK,K
	LL=MM(L)
91	Q(LL)=S+X*Q(LL)
	KK=K+1
80	CONTINUE

	IF(KK.GT.K)GO TO 180
C THIS FOR ITEMS BEYOND LAST IMPORTANT ITEM.
	R7=Q(LL)-R5
C R7=NEW POS. OF LAST IMPORTANT ITEM. R5=OLD POS.
	DO 280 L=KK,K
	LL=MM(L)
280	Q(LL)=R7+Q(LL)
180	LCNT=0
	NDPY=0
C JJ2 IS END OF PNTR DATA
	JPQ=KPN(JJ2-1)+1
	CALL PUTEXT(NMPG,'PAG')
	CALL EXTOUT(RSTFAC,128)
	CALL EXTOUT(PN,JJ2)
	CALL EXTOUT(Q,JPQ)
	CALL FINEXT

	LASTNM=NMPG
	LF=JJ2-2
	DO 12 J=1,LF
	IF(CODEN(KPN,J,Q,LA).NE.4)GO TO 12
	KBR=KBR+1
C BAR LINE COUNTER
	T=Q(LA+3)
C TOTAL SPACE
222	BARS(KBR)=T-RNEXT
C SIZE OF THIS MEASURE
	K=J
	RNEXT=T
12	CONTINUE
	IF(K.NE.LF)RNEXT=Q(KPN(LF)+3)
	RNEXT=RNEXT+3
322	NMPG=NMPG+2
122	KNM(1)=KNM(1)+2
	ENDLN=RNEXT
	END